home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / drwscr / drwscr.txt next >
Text File  |  1992-09-20  |  17KB  |  640 lines
  1. ' DRWSCR08.TXT
  2. ' DrawScript Routines
  3. '  Version 0.8
  4. '  9/19/92
  5. '
  6. ' Jim McClure (76666,1303)
  7. '
  8. ' Sorry about uploading this as TEXT. I'll PKZIP next time...
  9. '
  10. ' These routines are designed to simplify the programming of a 
  11. '  Print Preview capability for text-oriented reports. The routines
  12. '  record the sequence of Prints, Tabs, etc., for later
  13. '  playback to one or more objects (e.g., Printer object,
  14. '  picture control, etc.). The routines also provide pagination with
  15. '  header/footer control.
  16. '
  17. ' That's the good news. Now for the bad news. I'm still struggling with
  18. '  finding a good way to scale the text output for screen display so that
  19. '  it matches printer output. Currently, a point size of 8 is used for
  20. '  screen display because of some problems with printing sizes < 8. I
  21. '  will upload a revised display strategy later. For now, just use a
  22. '  picture control that scrolls vert. and horiz. A point size of 8 is
  23. '  more easily readable anyway!
  24. '
  25. ' WARNING!
  26. ' This code is still very much under development! I will be uploading
  27. '  revised versions periodically if there's enough interest. I will
  28. '  also try to upload an entire mini-project next, showing how to
  29. '  use the routines. In the meantime, EXPECT BUGS! Feel free to make
  30. '  enhancements, etc. (e.g., adding better line/box support would
  31. '  be nice). I'll be happy to share whatever improvements I make...
  32. '
  33. ' But first I have to get some sleep! <g>
  34. '
  35. '
  36. '----------------------------------
  37. 'Here is some example usage of the routines
  38. '
  39. '
  40. 'First, provide your own routine called "dsBoundaryPrint" to
  41. ' print headers and footers (boundaries) as needed. Your
  42. ' dsBoundaryPrint routine will be called as follows:
  43. '
  44. ' Sub dsBoundaryPrint(Region as integer, PageNum as integer)
  45. '
  46. 'In your routine, you can use dsPrint, dsTab, etc., calls to print
  47. ' a nice header (if Region = 1) or footer (if Region = 2) for
  48. ' your report. Just be sure to print the same # of lines that
  49. ' you specify in the dsNew() function below.
  50. '
  51. 'Create a new draw script for output page size of 60 lines,
  52. ' with 5 lines reserved for the header and 5 lines reserved for the
  53. ' footer, using the base font "Helv" point size 12:
  54. '
  55. ' hDS% = dsNew(60, 5, 5, "Helv", 12)
  56. '
  57. 'Print a few things to it:
  58. '
  59. ' dsPrintNL "Hello World!"
  60. ' dsTab 30
  61. ' dsPrintNL "This is indented!"
  62. ' dsFontUnderLine TRUE
  63. ' dsPrintNL "This is underlined!"
  64. ' dsFontUnderLine FALSE
  65. ' dsPrintAttr "This is also underlined!", "U"   'U = underline
  66. ' dsNL 'This finishes prior line
  67. ' dsLine 'This draws a simple separator line on the output
  68. ' (NOTE: The separator doesn't take up a "line" of output-- it leaves
  69. '  the print cursor where it is.)
  70. '
  71. 'Ok, we're done formatting
  72. ' dsClose(hDS%)
  73. '
  74. 'Find out how many pages were generated
  75. ' nPages = dsMaxPages()
  76. '
  77. '(Remember, each page will have the appropriate header/footer
  78. ' provided by your dsBoundaryPrint routine.)
  79. '
  80. 'Play them all back to the printer, starting at page #1
  81. ' dsPlay hDS%, DummyControl, TRUE, 1, nPages 'TRUE=Send to printer
  82. '
  83. 'Play one page of same report back to a picture box-- start at page #3 this time
  84. ' dsPlay hDS%, RealPictureControl, FALSE, 3, 1
  85. '(Now, set up a scroll bar or set of buttons to keep calling
  86. ' dsPlay with a larger PageStart, or allow user to jump directly
  87. ' to page # by entering it)
  88. '
  89. 'Ok, don't need this draw script anymore
  90. ' dsFree(hDS%)
  91. '(If you don't do this, a temp file will be left behind!)
  92. '
  93. 'GOOD LUCK!
  94. ' Jim
  95.  
  96. '----------------------------------
  97. 'This goes in your Global.Bas module
  98.  
  99. 'DrawScript data structure
  100. Type DrawScriptType
  101.   Alloc As Integer
  102.   FileNum As Integer
  103.   FileName As String
  104.   MaxLines As Integer
  105.   HeaderLines As Integer
  106.   FooterLines As Integer
  107.   CurLine As Integer
  108.   CurPage As Integer
  109.   MaxPages As Integer
  110. End Type
  111.  
  112. '----------------------------------
  113. 'This can go in a module called DrawScrpt.Bas
  114.  
  115. 'Allocate array of DrawScript structures
  116. Const nDrawScripts = 5
  117. Dim DrawScript(nDrawScripts) As DrawScriptType
  118.  
  119. 'The following hold the 'current' DS
  120. Dim dsCurrent As Integer
  121. Dim dsFileNum As Integer
  122. Dim dsMaxLines As Integer, dsHeaderLines As Integer, dsFooterLines As Integer
  123. Dim dsCurLine As Integer
  124. Dim dsInBoundary As Integer
  125. Dim dsCurPage As Integer, dsMaxPageNum As Integer
  126.  
  127. '----------------------------------
  128. 'Here come the routines
  129.  
  130. Sub dsPrint (PrintString As String)
  131.   'Print a string to the current DS
  132.   '
  133.   'Process header/footer
  134.   If Not dsInBoundary Then
  135.     dsCheckBoundary
  136.   End If
  137.  
  138.   'Print string
  139.   Print #dsFileNum, "PR " + PrintString
  140. End Sub
  141.  
  142. Sub dsPlay (hDS As Integer, c As Control, ToPrinter As Integer, PageStart As Integer, NumPages As Integer)
  143.   'Replay draw script on output device
  144.   'Either the Printer object (if ToPrinter is true)
  145.   ' or to the supplied control "c" (e.g., form, picture)
  146.   'Replay starts at PageStart (1st page = 1) and
  147.   'proceeds for NumPages pages
  148.   '
  149.   Dim InpString As String, Cmd As String, Arg As String
  150.   Dim FileNum As Integer, StopNow As Integer
  151.   Dim PageCount As Integer
  152.  
  153.   'Get a file number for use
  154.   FileNum = FreeFile
  155.   
  156.   'Open the file for processing
  157.   Open DrawScript(hDS).FileName For Input As #FileNum
  158.  
  159.   'See to starting page
  160.   PageCount = 1
  161.   Do While (PageCount < PageStart) And (Not EOF(FileNum))
  162.     'Read each line from the file
  163.     Line Input #FileNum, InpString
  164.  
  165.     'Increment page count
  166.     If Left$(InpString, 2) = "NP" Then
  167.       PageCount = PageCount + 1
  168.     End If
  169.   Loop
  170.  
  171.   'Process file 'till end
  172.   StopNow = FALSE
  173.   Do While (Not EOF(FileNum)) And (Not StopNow)
  174.  
  175.     'Read each line from the file
  176.     Line Input #FileNum, InpString
  177.  
  178.     'Separate command from data
  179.     Cmd = Left$(InpString, 2)
  180.     If Len(InpString) > 3 Then
  181.       Arg = Right$(InpString, Len(InpString) - 3)
  182.     Else
  183.       Arg = ""
  184.     End If
  185.  
  186.     'Depending on which command is present...
  187.     Select Case Cmd
  188.       Case "PR"
  189.         'Print a string
  190.         If ToPrinter Then
  191.           Printer.Print Arg;
  192.         Else
  193.           c.Print Arg;
  194.         End If
  195.       Case "NL"
  196.         'Start a new line
  197.         If ToPrinter Then
  198.           Printer.Print
  199.         Else
  200.           c.Print
  201.         End If
  202.       Case "TB"
  203.         'Tab to specified location
  204.         If ToPrinter Then
  205.           Printer.Print Tab(Val(Arg));
  206.         Else
  207.           c.Print Tab(Val(Arg));
  208.         End If
  209.       Case "LN"
  210.         'Draw separator line
  211.         If ToPrinter Then
  212.           Printer.Line -Step(Printer.ScaleWidth, 0)
  213.           Printer.CurrentX = 0
  214.         Else
  215.           c.Line -Step(c.Width, 0)
  216.           c.CurrentX = 0
  217.         End If
  218.       Case "FB"
  219.         'Set FontBold property
  220.         If ToPrinter Then
  221.           Printer.FontBold = Val(Arg)
  222.         Else
  223.           c.FontBold = Val(Arg)
  224.         End If
  225.       Case "FU"
  226.         'Set FontUnderline property
  227.         If ToPrinter Then
  228.           Printer.FontUnderline = Val(Arg)
  229.         Else
  230.           c.FontUnderline = Val(Arg)
  231.         End If
  232.       Case "FI"
  233.         'Set FontItalic property
  234.         If ToPrinter Then
  235.           Printer.FontItalic = Val(Arg)
  236.         Else
  237.           c.FontItalic = Val(Arg)
  238.         End If
  239.       Case "FS"
  240.         'Set FontStrikethru property
  241.         If ToPrinter Then
  242.           Printer.FontStrikethru = Val(Arg)
  243.         Else
  244.           c.FontStrikethru = Val(Arg)
  245.         End If
  246.       Case "FZ"
  247.         'Set FontSize property
  248.         If ToPrinter Then
  249.           Printer.FontSize = Val(Arg)
  250.         Else
  251.           'Scale font size for screen
  252.           c.FontSize = 8
  253.         End If
  254.       Case "FN"
  255.         'Set FontName property
  256.         If ToPrinter Then
  257.           Printer.FontName = Arg
  258.         Else
  259.           c.FontName = Arg
  260.         End If
  261.       Case "NP"
  262.         'Start new page
  263.         If ToPrinter Then
  264.           Printer.NewPage
  265.         End If
  266.  
  267.         'Keep track of # of pages
  268.         PageCount = PageCount + 1
  269.  
  270.         'See if we should quit
  271.         If (Not ToPrinter) Or (PageCount = PageStart + NumPages) Then
  272.           StopNow = TRUE
  273.         End If
  274.     End Select
  275.   Loop
  276.